home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
tjgold.zip
/
INSTALL.001
/
GOLDKEY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-12
|
32KB
|
1,261 lines
{--------------------------------------------------------------------------}
{ Product: TechnoJock's Turbo Toolkit }
{ Version: GOLD }
{ Build: 1.01 }
{ }
{ Copyright 1986-1995 TechnoJock Software, Inc. }
{ All Rights Reserved }
{ Restricted by License }
{--------------------------------------------------------------------------}
{*********************************}
{** Unit: GOLDKEY **}
{*********************************}
{++++++++++++++++++++++++++++++} unit GOLDKEY; {+++++++++++++++++++++++++++++}
{$I GOLDFLAG.INC}
{$IFNDEF GOLDKEY}
{$DEFINE GOLDKEY}
{$ENDIF}
{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
uses DOS, CRT, GoldHard;
const
GStuffBufferSize = 30;
GUpperCharSet = ['A'..'Z'];
GLowerCharSet = ['a'..'z'];
GPuncCharSet = [',',';',':','.',' '];
ContextMenu = 1000;
ContextList = 2000;
ContextIO = 3000;
ContextDir = 4000;
ContextCalc = 5000;
ContextCal = 6000;
type
HelpRecord = record
Context: word;
ID: word;
case word of {variant record}
0: (HelpPtr: pointer);
1: (HelpLong: longint);
2: (HelpChar: char);
end;
{$IFDEF TTT5}
Key_Pressed_Type = procedure(var Ch:char);
{$ENDIF}
KeyIdleHook = procedure;
KeyPressedHook = procedure(var Code:word; var X,Y:byte);
KeyHelpHook = procedure(Context:word; HelpInfo: HelpRecord);
KeySet = record
LastECode: integer;
{mouse data}
ButtonCount: byte; {0 means no mouse installed}
MouseActive: boolean;
RightHanded: boolean;
MouseVisible: boolean;
MouseWasVisible: boolean;
DoubleDelay: integer;
{keyboard data}
Click: boolean; {click after every keypress?}
Buffer: array[1..GStuffBufferSize] of word;
BufferHead: word; {next character from buffer}
BufferTail: word; {last valid character in buffer}
LastKey: word; {the last key pressed}
LastX:byte; {location of mouse when button pressed}
LastY:byte; { -"- }
IdleHook: KeyIdleHook;
PressedHook: KeyPressedHook;
HelpHook: KeyHelpHook;
Time: Longint; {the time the last key was processed}
Extended : boolean; {is it an extended keyboard}
InitScrollDelay: integer;
ScrollDelay: integer;
HelpKey: word;
end;
var
KeyVars: KeySet;
{mouse routines}
function MouseInstalled:boolean;
procedure MouseHardwareReset;
procedure MouseSoftwareReset;
procedure MouseShow(On:boolean);
procedure MouseMove(X,Y: integer);
procedure MouseConfine(X1,Y1,X2,Y2:integer);
procedure MousePos(var X,Y : byte);
function MouseReleased(Button: integer; var X,Y: byte): byte;
function MousePressed(Button: integer; var X,Y: byte): byte;
function MouseInZone(X1,Y1,X2,Y2: byte):boolean;
procedure MouseStatus(var L,C,R:boolean; var X,Y : byte);
procedure MouseStatusWin(var L,C,R:boolean; var X,Y : byte);
procedure MouseStyle(OrdChar,Attr: byte);
procedure MouseRelease;
{buffer routines}
procedure KeyFlushBuffer;
function KeyBufferSpace:word;
procedure KeyStuffBuffer(W:word);
procedure KeyStuffBufferMouse(W:word;X,Y:byte);
procedure KeyStuffBufferStr(Str:string);
{hook routines}
procedure AssignPressedHook(Hook:KeyPressedHook);
procedure AssignIdleHook(Hook:KeyIdleHook);
procedure AssignHelpHook(Hook:KeyHelpHook);
procedure CallForHelp(Context:word; HelpInfo: HelpRecord);
{key routines}
procedure NoKeyIdleHook;
procedure NoKeyPressedHook(var W:word; var X,Y:byte);
function WordToChar(W:word):char;
function GKeyPressed:boolean;
function KeyorMousePressed: boolean;
function ExtendedKeyBoard:boolean;
{key reading procs}
function GetKey:char;
procedure GetInput;
procedure GetInputRel;
procedure GetInputWait(WaitTime:longint);
procedure DelayKey(WaitTime:longint);
function KeyGetTime: longint;
{keyboard properties}
procedure KeySetSlow;
procedure KeySetFast;
procedure KeySetRepeatRate(Delay,Rate:byte);
{auxilary keys}
function KeyShiftPressed: boolean;
function KeyRightShiftPressed: boolean;
function KeyLeftShiftPressed: boolean;
function KeyCtrlPressed:boolean;
function KeyAltPressed:boolean;
function KeyGetScroll:boolean;
function KeyGetNum:boolean;
function KeyGetCaps:boolean;
procedure KeySetScroll(On:boolean);
procedure KeySetNum(On:boolean);
procedure KeySetCaps(On:boolean);
procedure KeySetClicking(Clicking : boolean);
{help routines}
{$IFDEF TTT5}
procedure No_Idle_Hook;
procedure No_Pressed_Hook(var Ch:char);
procedure Assign_Idle_Hook(PassedProc : KeyIdleHook);
procedure Set_Clicking(Clicking : boolean);
procedure Default_Settings;
function Mouse_Installed:Boolean;
procedure Show_Mouse_Cursor;
procedure Hide_Mouse_Cursor;
procedure Move_Mouse(Hor,Ver: integer);
procedure Confine_Mouse_Horiz(Left,Right:integer);
procedure Confine_Mouse_Vert(Top,Bot:integer);
procedure Set_Mouse_Cursor_Style(OrdChar: integer);
function Alt_Pressed:Boolean;
function Ctrl_Pressed:Boolean;
function LeftShift_Pressed: Boolean;
function RightShift_Pressed: Boolean;
function Shift_Pressed: Boolean;
function CapsOn: Boolean;
function NumOn: Boolean;
function ScrollOn: Boolean;
procedure Set_Caps(On : boolean);
procedure Set_Num(On : boolean);
procedure Set_Scroll(On : boolean);
procedure FlushKeyBuffer;
{$ENDIF}
{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
uses GoldFast;
const
MouseInt = $33;
KeyInt = $16;
ClockTicks = 18.2;
var
KeyStatusBits: ^word;
DOSBufferHead: ^word;
DOSBufferTail: ^word;
function LastKeyError: integer;
{}
begin
LastKeyError := KeyVars.LastEcode;
end; { LastKeyError }
{**********************}
{** Mouse Routines **}
{**********************}
function MouseInstalled:boolean;
{}
var
MouseInterruptPtr: pointer;
Reg: registers;
Installed: boolean;
begin
MouseInterruptPtr := ptr($0000,$00CC);
if (MouseInterruptPtr = nil)
or (byte(MouseInterruptPtr) = $CF) then
Installed := false {don't call interrupt if vector is zero}
else with KeyVars do
begin
Reg.Ax := $21;
Intr($33,Reg);
Installed := Reg.Ax = $FFFF;
if Installed then
ButtonCount := Reg.Bx
else
ButtonCount := 0;
end;
MouseInstalled := Installed;
end; { MouseInstalled }
procedure MouseHardwareReset;
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
Regs.Ax := $00;
Intr(MouseInt,Regs);
KeyVars.ButtonCount := Regs.Bx;
KeyVars.MouseVisible := false;
end;
end; { MouseHardwareReset }
procedure MouseSoftwareReset;
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
Regs.Ax := $21;
Intr(MouseInt,Regs);
KeyVars.ButtonCount := Regs.Bx;
KeyVars.MouseVisible := false;
end;
end; { MouseSoftwareReset }
procedure MouseShow(On:boolean);
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
if On then
Regs.Ax := $01
else
Regs.Ax := $02;
KeyVars.MouseVisible := On;
Intr(MouseInt,Regs);
end;
end; { MouseShow }
procedure MouseMove(X,Y: integer);
{X and Y are character positions not pixel positions}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
with Regs do
begin
Ax := $04;
Cx := pred(X*8); {8 pixels per character}
Dx := pred(Y*8); { "-" }
end; {with}
Intr(MouseInt,Regs);
end;
end; { MouseMove }
procedure MouseConfine(X1,Y1,X2,Y2:integer);
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
with Regs do
begin
{horizontal}
Ax := $07;
Cx := pred(X1*8);
Dx := pred(X2*8);
intr(MouseInt,Regs);
{vertical}
Ax := $08;
Cx := pred(Y1*8);
Dx := pred(Y2*8);
intr(MouseInt,Regs);
end;
end; { MouseConfine }
procedure MousePos(var X,Y : byte);
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
with Regs do
begin
Ax := 3;
intr(MouseInt,Regs);
X := succ(Cx div 8);
Y := succ(Dx div 8);
end; {with}
end; { MousePos }
function AdjustedButton(Button:integer):integer;
{used internally to swap the role of left and right buttons}
begin
if (KeyVars.RightHanded = false) or (Button > 2) then
AdjustedButton := Button
else
AdjustedButton := ord(Button = 0);
end; { AdjustedButton }
function MouseReleased(Button: integer; var X,Y: byte): byte;
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
with Regs do
begin
Ax := 6;
Bx := AdjustedButton(Button);
intr(MouseInt,Regs);
MouseReleased := Bx;
X := succ(Cx div 8);
Y := succ(Dx div 8);
end;
end
else
MouseReleased := 0;
end; { MouseReleased }
function MousePressed(Button: integer; var X,Y: byte): byte;
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
with Regs do
begin
Ax := 5;
Bx := AdjustedButton(Button);
intr(MouseInt,Regs);
MousePressed := Bx;
X := succ(Cx div 8);
Y := succ(Dx div 8);
end;
end else
MousePressed := 0;
end; { MousePressed }
procedure ClearMouseBuffers;
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
with Regs do
begin
Ax := 5; Bx := 0; intr(MouseInt,Regs);
Ax := 5; Bx := 1; intr(MouseInt,Regs);
Ax := 6; Bx := 0; intr(MouseInt,Regs);
Ax := 6; Bx := 1; intr(MouseInt,Regs);
if KeyVars.ButtonCount = 3 then
begin
Ax := 5; Bx := 2; intr(MouseInt,Regs);
Ax := 6; Bx := 2; intr(MouseInt,Regs);
end;
end;
end;
end; { ClearMouseBuffers }
function MouseInZone(X1,Y1,X2,Y2: byte): boolean;
{}
var X,Y: byte;
begin
if KeyVars.MouseActive and KeyVars.MouseVisible then
begin
MousePos(X,Y);
MouseInZone := (X >= X1) and (X <= X2) and (Y >= Y1) and (Y <= Y2);
end else
MouseInZone := false;
end; { MouseInZone }
procedure MouseStatus(var L,C,R: boolean; var X,Y: byte);
{}
var Regs: registers;
begin
if KeyVars.MouseActive then
begin
with Regs do
begin
Ax := 3;
intr(MouseInt,Regs);
X := succ(Cx div 8);
Y := succ(Dx div 8);
if not KeyVars.RightHanded then
begin
L := ((BX and $01) = $01);
R := ((BX and $02) = $02);
end else
begin
R := ((BX and $01) = $01);
L := ((BX and $02) = $02);
end;
C := ((BX and $04) = $04);
end; {with}
end else
begin
L := false;
C := false;
R := false;
X := 1;
Y := 1;
end;
end; { MouseStatus }
procedure MouseStatusWin(var L,C,R: boolean; var X,Y: byte);
{Like MouseStatus, But X and Y are local to the Window}
begin
MouseStatus(L,C,R,X,Y);
if (VideoTarget.TargetType = WinTarget) then
begin
dec(X,pred(WStructurePtr(VideoTarget.TargetPtr)^.X));
dec(Y,pred(WStructurePtr(VideoTarget.TargetPtr)^.Y));
end;
if VideoTarget.WindowActive then
begin
dec(X,pred(VideoTarget.WX1));
dec(Y,pred(VideoTarget.WY1));
end;
end; { MouseStatusWin }
procedure MouseStyle(OrdChar,Attr: byte);
{changes the style of the floating mouse cursor}
var
Regs: registers;
begin
if KeyVars.MouseActive then
begin
Regs.Ax := 10;
Regs.Bx := 0; {software text cursor}
if Attr = 0 then
Regs.CX := $7700
else
Regs.Cx := $00;
Regs.Dl := OrdChar;
Regs.Dh := Attr;
Intr(MouseInt,Regs);
end;
end; { MouseStyle }
procedure MouseRelease;
{Waits for all mouse buttons to be released and clears the
pressed history}
var
L,M,R: boolean;
X,Y,P: byte;
begin
repeat
MouseStatus(L,M,R,X,Y);
until not L and not M and not R;
P := MouseReleased(0,X,Y);
P := MouseReleased(1,X,Y);
if KeyVars.ButtonCount > 2 then
P := MouseReleased(2,X,Y);
end; { MouseRelease }
{*************************}
{** Keyboard Routines **}
{*************************}
{$IFOPT F-}
{$DEFINE FOFF}
{$F+}
{$ENDIF}
procedure NoKeyIdleHook;
{empty procs}
begin end; {NoKeyIdleHook}
procedure NoKeyPressedHook(var W:word; var X,Y:byte);
{empty procs}
begin end; {NoKeyPressedHook}
procedure NoHelpHook(Context:word; HelpInfo: HelpRecord);
{empty procs}
begin end; {NoHelpHook}
{$IFDEF FOFF}
{$F-}
{$UNDEF FOFF}
{$ENDIF}
procedure AssignPressedHook(Hook:KeyPressedHook);
{}
begin
KeyVars.PressedHook := Hook;
end; { AssignPressedHook }
procedure AssignIdleHook(Hook:KeyIdleHook);
{}
begin
KeyVars.IdleHook := Hook;
end; { AssignIdleHook }
procedure AssignHelpHook(Hook:KeyHelpHook);
{}
begin
KeyVars.helpHook := Hook;
end; { AssignHelpHook }
function WordToChar(W:word):char;
{}
begin
If W > 255 then
WordToChar := #0
else
WordToChar := chr(W);
end; { WordToChar }
function KeyorMousePressed:boolean;
{}
var
L,C,R:boolean;
X,Y : byte;
begin
MouseStatus(L,C,R,X,Y);
with KeyVars do
KeyorMousePressed := (BufferHead <> BufferTail)
or
(DOSBufferHead^ <> DOSBufferTail^)
or L or R or C;
end; { KeyorMousePressed }
function GKeyPressed:boolean;
{}
begin
with KeyVars do
GKeyPressed := (BufferHead <> BufferTail)
or
(DOSBufferHead^ <> DOSBufferTail^);
end; { GKeyPressed }
function ExtendedKeyBoard:boolean;
{}
var Regs: registers;
begin
ExtendedKeyBoard := false;
Regs.Ah := $12;
intr(KeyInt,Regs);
if Regs.Al = KeyStatusBits^ then {might be extended}
begin
KeyStatusBits^ := KeyStatusBits^ XOR $20;
Regs.Ah := $12;
intr(KeyInt,Regs);
ExtendedkeyBoard := Regs.Al = KeyStatusBits^;
KeyStatusBits^ := KeyStatusBits^ XOR $20;
end;
end; { ExtendedKeyBoard }
procedure KeySetCaps(On:boolean);
{}
begin
if On then
KeyStatusBits^ := (KeyStatusBits^ or $40)
else
KeyStatusBits^ := (KeyStatusBits^ and $BF);
end; { KeySetCaps }
procedure KeySetNum(On:boolean);
{}
begin
if On then
KeyStatusBits^ := (KeyStatusBits^ or $20)
else
KeyStatusBits^ := (KeyStatusBits^ and $DF);
end; { KeySetNum }
procedure KeySetScroll(On:boolean);
{}
begin
if On then
KeyStatusBits^ := (KeyStatusBits^ or $10)
else
KeyStatusBits^ := (KeyStatusBits^ and $EF);
end; { KeySetScroll }
function KeyGetCaps:boolean;
{}
var CapsOnW: word;
begin
CapsOnW := swap(KeyStatusBits^);
KeyGetCaps := (CapsOnW and $4000) <> 0;
end; { KeyGetCaps }
function KeyGetNum:boolean;
{}
var NumOnW: word;
begin
NumOnW := swap(KeyStatusBits^);
KeyGetNum := (NumOnW and $2000) <> 0;
end; { KeyGetNum }
function KeyGetScroll:boolean;
{}
var ScrollOnW: word;
begin
ScrollOnW := swap(KeyStatusBits^);
KeyGetScroll := (ScrollOnW and $1000) <> 0;
end; { KeyGetScroll }
function KeyAltPressed:boolean;
var
AltW: word;
begin
AltW := swap(KeyStatusBits^);
KeyAltPressed := (AltW and $0800) <> 0;
end; { KeyAltPressed }
function KeyCtrlPressed:boolean;
var
CtrlW: word;
begin
CtrlW := swap(KeyStatusBits^);
KeyCtrlPressed := (CtrlW and $0400) <> 0;
end; { KeyCtrlPressed }
function KeyLeftShiftPressed: boolean;
{}
var LSW: word;
begin
LSW := swap(KeyStatusBits^);
KeyLeftShiftPressed := (LSW and $0200) <> 0;
end; { KeyLeftShiftPressed }
function KeyRightShiftPressed: boolean;
{}
var RSW: word;
begin
RSW := swap(KeyStatusBits^);
KeyRightShiftPressed := (RSW and $0100) <> 0;
end; { KeyRightShiftPressed }
function KeyShiftPressed: boolean;
{}
var SW: word;
begin
SW := swap(KeyStatusBits^);
KeyShiftPressed := ((SW and $0200) <> 0) or ((SW and $0100) <> 0);
end; { KeyShiftPressed }
procedure KeySetRepeatRate(Delay,Rate:byte);
{}
var Regs: registers;
begin
with Regs do
begin
Ah := 3;
Al := 5;
Bl := Rate;
Bh := pred(Delay);
end;
Intr(KeyInt,Regs);
end; { KeySetRepeatRate }
procedure KeySetFast;
{}
begin
KeySetRepeatRate(1,0);
end; { KeySetFast }
procedure KeySetSlow;
{}
begin
KeySetRepeatRate(2,$14);
end; { KeySetSlow }
procedure KeyClick;
{INTERNAL}
begin
sound(1000);
sound(50);
delay(5);
nosound;
end; { KeyClick }
function KeyExtendedKey(var K:byte):boolean;
{INTERNAL}
var Regs: registers;
begin
with Regs do
begin
if KeyVars.Extended then
Ah := $10
else
Ah := $0;
intr(KeyInt,Regs);
if (Al = 0) or (Al = $E0) then
begin
K := Ah;
KeyExtendedKey := true;
end else
begin
K := Al;
KeyExtendedKey := false;
end;
end;
end; { KeyExtendedKey }
function KeyReadKey: char;
const ch: char = #0;
var K: byte;
begin
if Ch = #0 then
begin
if KeyExtendedKey(K) then
begin
KeyReadkey := Ch;
Ch := chr(K);
end else
begin
KeyReadKey := chr(K);
Ch := #0;
end;
end else
begin
KeyReadkey := Ch;
Ch := #0;
end;
end; { KeyReadKey }
function KeyBufferSpace:word;
{}
begin
with KeyVars do
KeyBufferSpace := GStuffBufferSize - abs(BufferTail-BufferHead);
end; { KeyBufferSpace }
procedure KeyFlushBuffer;
{}
var Regs: registers;
begin
with KeyVars do
BufferTail := BufferHead; {empty program buffer}
with Regs do
begin
Ax := ($0C shl 8) or 6;
Dx := $00FF;
end;
Intr($21,Regs);
end; { KeyFlushBuffer }
procedure KeyFlushDOSBuffer;
var Regs : registers;
begin
with Regs do
begin
Ax := ($0c shl 8) or 6;
Dx := $00ff;
end;
Intr($21,Regs);
end; { KeyFlushDOSBuffer }
procedure KeyStuffBuffer(W:word);
{adds word to program input buffer}
begin
with KeyVars do
begin
if (BufferTail + 1 = BufferHead)
or ((BufferTail = GStuffBufferSize) and (BufferHead = 1)) then
exit; {buffer full}
Buffer[BufferTail] := W;
if BufferTail < GStuffBufferSize then
inc(BufferTail)
else
BufferTail := 1;
end;
end; { KeyStuffBuffer }
procedure KeyStuffBufferMouse(W:word;X,Y:byte);
{adds a mouse press and mouse coords to the buffer}
begin
KeyStuffBuffer(W);
KeyStuffBuffer(X);
KeyStuffBuffer(Y);
end; { KeyStuffBufferMouse }
function KeyGetTime: longint;
{}
var T: longint;
begin
{$IFDEF DPMI}
T := MemL[Seg0040:$006C];
{$ELSE}
T := MemL[$0040:$006C];
{$ENDIF}
KeyGetTime := T;
end; { KeyGetTime }
procedure KeyStuffBufferStr(Str:string);
{}
var I,L: byte;
begin
if Str <> '' then
begin
I := 1;
L := length(Str);
if L > GStuffBufferSize then
L := GStuffBufferSize;
while I <= L do
begin
KeyStuffBuffer(ord(Str[I]));
inc(I);
end;
end;
end; { KeyStuffBufferStr }
procedure KeyGetInputEngine;
{waits for a keypress or mouse activity - exits when keypressed
or when a mouse button is pressed DOWN}
var
L,C,R,
Finished: boolean;
Ch: char;
Keyword: word;
X,Y: byte;
ThisTime: longint;
procedure MoveBufferHead;
begin
with KeyVars do
if BufferHead < GStuffBufferSize then
inc(BufferHead)
else
BufferHead := 1;
end; { MoveBufferHead }
function ReadFromBuffer:boolean;
begin
with KeyVars do
if BufferHead <> BufferTail then {read from buffer}
begin
Keyword := Buffer[BufferHead];
MoveBufferHead;
if (KeyWord >= 513) and (KeyWord <= 525) then
begin
X := Buffer[BufferHead];
MoveBufferHead;
Y := Buffer[BufferHead];
MoveBufferHead;
end;
ReadFromBuffer := true;
end else
ReadFromBuffer := false;
end; { ReadFromBuffer }
procedure CheckButtonCombos;
{Checks to see if Alt Ctrl or Shift are pressed while mouse down}
begin
if KeyAltPressed then
inc(Keyword)
else if KeyCtrlPressed then
inc(Keyword,2)
else if KeyShiftPressed then
inc(Keyword,3);
end; { CheckButtonCombos }
begin
if not ReadFromBuffer then
begin
Finished := false;
repeat
KeyVars.IdleHook; {call the users idle hook procedure}
if ReadFromBuffer then {see if user's hook stuffed the buffer}
Finished := true
else if KeyVars.MouseActive then
begin
Keyword := 0;
MouseStatus(L,C,R,X,Y);
if L then
KeyWord := 500 {left button down}
else if R then
KeyWord := 504 {right button down}
else if C then
KeyWord := 508; {middle button down}
CheckButtonCombos;
ThisTime := KeyGetTime;
if (KeyVars.LastX = X) {mouse in same place}
and (KeyVars.LastY = Y)
and (L or C or R)
and ((KeyWord = KeyVars.Lastkey) or (KeyWord+20 = KeyVars.Lastkey))
and ((ThisTime - KeyVars.Time) <= (KeyVars.DoubleDelay div 55)) then
inc(KeyWord,40); {make it a double!}
if L or R or C then {a button is being depressed}
Finished := true;
end;
until Finished or GKeyPressed;
if not Finished then
begin
Ch := KeyReadKey;
if Ch = #0 then
begin
Ch := KeyReadkey;
Keyword := 256+ord(Ch);
if (KeyWord >= 327) and (Keyword <= 339) then
begin
if KeyAltPressed then
inc(Keyword,80)
else if (KeyShiftPressed and KeyVars.Extended) then
case Keyword of {fix for George's BIOS!}
338: Keyword := 261;
339: Keyword := 263;
9: Keyword := 271;
else
inc(Keyword,100)
end {case}
else if KeyCtrlPressed then
inc(Keyword,120);
end;
end else
KeyWord := ord(Ch);
end;
end;
with KeyVars do
begin
Time := KeyGetTime;
LastKey := Keyword;
LastX := X;
LastY := Y;
if Click then
KeyClick;
end;
end; { KeyGetInputEngine }
procedure GetInput;
{}
begin
KeyGetInputEngine;
with KeyVars do
PressedHook(LastKey,LastX,LastY)
end; { GetInput }
procedure GetInputRel;
{}
var L,R,M : boolean;
begin
KeyGetInputEngine;
with KeyVars do
begin
if (LastKey >= 500) and (LastKey <= 511) then
begin
MouseRelease;
inc(Lastkey,20);
MouseStatus(L,M,R,LastX,LastY);
end;
PressedHook(LastKey,LastX,LastY);
end;
end; {GetInputRel}
procedure GetInputWait(WaitTime:longint);
{Waits for input, but returns a zero if the specified elapsed time has passed.
If the WaitTime is passed as zero, the routine will wait indefinitely.
}
var
L,M,R: boolean;
X,Y: byte;
StartTime: longint;
begin
StartTime := KeyGetTime;
repeat
KeyVars.IdleHook; {call the users idle hook procedure}
MouseStatus(L,M,R,X,Y);
until L or M or R or GkeyPressed
or ( (WaitTime <> 0) and (((KeyGetTime - StartTime) / ClockTicks)*1000 > WaitTime));
if not L and not M and not R and not Gkeypressed then
KeyVars.Lastkey := 0
else
GetInput;
end; { GetInputWait }
function GetKey:char;
{Waits for keyboard activity and returns the char pressed}
begin
repeat
GetInput;
until (KeyVars.LastKey >= 13) and (KeyVars.LastKey <= 255);
GetKey := char(KeyVars.LastKey);
end; { GetInput }
procedure DelayKey(WaitTime:longint);
{Pauses for the user to click a mouse button, press a key, or for a specified
time to elapse. If the WaitTime is passed as zero, the routine will wait
indefinitely. The KeyVars entry is *not* updated with the key.}
var
L,M,R: boolean;
X,Y: byte;
StartTime: longint;
begin
StartTime := KeyGetTime;
repeat
KeyVars.IdleHook; {call the users idle hook procedure}
MouseStatus(L,M,R,X,Y);
until L or M or R or GkeyPressed
or ( (WaitTime > 0) and (((KeyGetTime - StartTime) / ClockTicks)*1000 > WaitTime));
if L or M or R then
MouseRelease;
KeyFlushBuffer;
end; { DelayKey }
procedure KeySetClicking(Clicking : boolean);
{}
begin
KeyVars.Click := Clicking;
end; { KeySetClicking }
{*********************}
{** Help Routines **}
{*********************}
procedure CallForHelp(Context:word; HelpInfo: HelpRecord);
{}
begin
if @KeyVars.HelpHook <> nil then
KeyVars.HelpHook(Context,HelpInfo);
end; { CallForHelp }
{*********************************************}
{** U N I T I N I T I A L I Z A T I O N **}
{*********************************************}
procedure KeyDefaultSettings;
{}
begin
with KeyVars do
begin
RightHanded := false;
DoubleDelay := 350;
Click := false;
InitScrollDelay := 350;
ScrollDelay := 50;
HelpKey := 315; {F1}
IdleHook := NoKeyIdleHook;
PressedHook := NoKeyPressedHook;
HelpHook := NoHelpHook;
end;
end; { KeyDefaultSettings }
procedure GoldKeyInit;
{}
begin
{$IFDEF DPMI}
KeyStatusBits := ptr(seg0040,$0017);
DOSBufferHead := ptr(seg0040,$001A);
DOSBufferTail := ptr(seg0040,$001C);
{$ELSE}
KeyStatusBits := ptr($0040,$0017);
DOSBufferHead := ptr($0040,$001A);
DOSBufferTail := ptr($0040,$001C);
{$ENDIF}
with KeyVars do
begin
LastECode := 0;
MouseActive := MouseInstalled;
MouseVisible := false;
BufferHead := 1;
BufferTail := 1;
LastKey := 0;
LastX := 0;
LastY := 0;
Extended := ExtendedKeyBoard;
end;
KeyDefaultSettings;
end; {GoldKeyInit}
{$IFDEF TTT5}
{$IFOPT F-}
{$DEFINE FOFF}
{$F+}
{$ENDIF}
procedure No_Idle_Hook;
{included for TTT5 compatibility}
begin
{ abstract } {NoKeyIdleHook;}
end; { No_Idle_Hook }
procedure No_Pressed_Hook(var Ch:char);
{included for TTT5 compatibility}
begin
{ abstract } {NoKeyPressedHook;}
end; { No_Pressed_Hook }
{$IFDEF FOFF}
{$F-}
{$UNDEF FOFF}
{$ENDIF}
procedure Assign_Idle_Hook(PassedProc: KeyIdleHook);
{included for TTT5 compatibility}
begin
AssignIdleHook(PassedProc);
end; { Assign_Idle_Hook }
procedure Set_Clicking(Clicking: boolean);
{included for TTT5 compatibility}
begin
KeySetClicking(Clicking);
end; { Set_Clicking }
procedure Default_Settings;
{included for TTT5 compatibility}
begin
{ abstract }
end; { Default_Settings }
function Mouse_Installed:boolean;
{included for TTT5 compatibility}
begin
Mouse_Installed := MouseInstalled;
end; { Mouse_Installed }
procedure Show_Mouse_Cursor;
{included for TTT5 compatibility}
begin
MouseShow(true);
end; { Show_Mouse_Cursor }
procedure Hide_Mouse_Cursor;
{included for TTT5 compatibility}
begin
MouseShow(false);
end; { Hide_Mouse_Cursor }
procedure Move_Mouse(Hor,Ver: integer);
{included for TTT5 compatibility}
begin
MouseMove(Hor,Ver);
end; { Move_Mouse }
procedure Confine_Mouse_Horiz(Left,Right:integer);
{included for TTT5 compatibility}
var Regs: registers;
begin
if KeyVars.MouseActive then
with Regs do
begin
{horizontal}
Ax := $07;
Cx := pred(Left*8);
Dx := pred(Right*8);
intr(MouseInt,Regs);
end;
end; { Confine_Mouse_Horiz }
procedure Confine_Mouse_Vert(Top,Bot:integer);
{included for TTT5 compatibility}
var Regs: registers;
begin
if KeyVars.MouseActive then
with Regs do
begin
{vertical}
Ax := $08;
Cx := pred(Top*8);
Dx := pred(Bot*8);
intr(MouseInt,Regs);
end;
end; { Confine_Mouse_Vert }
procedure Set_Mouse_Cursor_Style(OrdChar: integer);
{included for TTT5 compatibility}
begin
MouseStyle(OrdChar,0);
end; { Set_Mouse_Cursor_Style }
function Alt_Pressed:boolean;
{included for TTT5 compatibility}
begin
Alt_Pressed := KeyAltPressed;
end; { Alt_Pressed }
function Ctrl_Pressed:boolean;
{included for TTT5 compatibility}
begin
Ctrl_Pressed := KeyCtrlPressed;
end; { Ctrl_Pressed }
function LeftShift_Pressed: boolean;
{included for TTT5 compatibility}
begin
LeftShift_Pressed := KeyLeftShiftPressed;
end; { LeftShift_Pressed }
function RightShift_Pressed: boolean;
{included for TTT5 compatibility}
begin
RightShift_Pressed := KeyRightShiftPressed;
end; { RightShift_Pressed }
function Shift_Pressed: boolean;
{included for TTT5 compatibility}
begin
Shift_Pressed := KeyShiftPressed;
end; { Shift_Pressed }
function CapsOn: boolean;
{included for TTT5 compatibility}
begin
CapsOn := KeyGetCaps;
end; { CapsOn }
function NumOn: boolean;
{included for TTT5 compatibility}
begin
NumOn := KeyGetNum;
end; { NumOn }
function ScrollOn: boolean;
{included for TTT5 compatibility}
begin
ScrollOn := KeyGetScroll;
end; { ScrollOn }
procedure Set_Caps(On : boolean);
{included for TTT5 compatibility}
begin
KeySetCaps(On);
end; { Set_Caps }
procedure Set_Num(On : boolean);
{included for TTT5 compatibility}
begin
KeySetNum(On);
end; { Set_Num }
procedure Set_Scroll(On : boolean);
{included for TTT5 compatibility}
begin
KeySetScroll(On);
end; { Set_Scroll }
procedure FlushKeyBuffer;
{included for TTT5 compatibility}
begin
KeyFlushDOSBuffer;
end; { FlushKeyBuffer }
{$ENDIF}
begin
GoldKeyInit;
end.